home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
050
/
madtrb7.arc
/
GETDIR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1984-11-21
|
2KB
|
72 lines
{getdir5 -- get disk directory sectors
(C) Copyright 1982 by Walter H. Rauser
getdir5.pas -- version using pascal convention for buffer.
under development <whr 5-16-82>
just recovered from FAT crash caused by Linker!!!
exchanged disks as directed because file not on disk
}
PROGRAM TESTGETDIR(input,output);
type drivetype = (A,B);
dirtype = array[1..112] of record {DOS 1.10 Double Sided Drives}
name [0]:string(8);
ext [8]:string(3);
attr [11]:byte;
resvd [12]:array[1..10] of byte;
time [22]:array[1..2] of byte;
date [24]:array[1..2] of byte;
cluster1 [26]:array[1..2] of byte;
sizel [28]:array[1..2] of byte;
sizeh [30]:array[1..2] of byte;
end;
var dir1 :dirtype;
drive :drivetype;
{EXTERN declarations}
function GETSEC( drive,first,numof :integer;
var buffer :dirtype; var errorc :integer
):boolean; EXTERN ;
{GETDIR - function to get directory sectors from disk.}
function GETDIR( drive :drivetype;
var dir :dirtype ):boolean;
var dr, errorc :integer;
begin {getdir}
dr := ord(drive);
{add code to get FAT and test for double sided drives}
{only get first four file sectors to show how it's done}
if getsec( dr, 3, 4, dir, errorc ) then getdir := true
else begin
getdir := false;
writeln('Get Directory Sector Failed');
writeln('ERROR CODE = ', errorc:6:16 );
end;
end; {getdir}
{-------------------------------------------------------------------}
var i,j :integer;
begin {testgetdir}
for i:= 1 to 112 do dir1[i].name := ' ';
drive := B;
if getdir( drive, dir1 ) then begin
for i := 1 to 64 do
with dir1[i] do
[
write(i:5,' ', name,'.',ext,' ',attr:2:16,' ');
for j:=1 to 10 do write(resvd[j]:2:16); write(' ');
for j:= 1 to 2 do write(time[j]:2:16); write(' ');
for j:= 1 to 2 do write(date[j]:2:16); write(' ');
for j:= 1 to 2 do write(cluster1[j]:2:16); write(' ');
for j:= 1 to 2 do write(sizel[j]:2:16); write(' ');
for j:= 1 to 2 do write(sizeh[j]:2:16); write(' ');
writeln;
]
end
else abort('Aborting in TESTGETDIR',1,1);
end. {testgetdir}